home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MPW Oberon 2.1168 / OInterfaces / fenv.mod < prev    next >
Encoding:
Text File  |  1995-08-10  |  10.2 KB  |  267 lines  |  [TEXT/MPS ]
  1. (*
  2.      File:        fenv.mod
  3.  
  4.      Copyright:    © 1984-1994 by Apple Computer, Inc.
  5.                  All rights reserved.
  6.  
  7.      Version:    Universal Pascal, July 8, 1994 
  8.     
  9.     Note:        The following file was hand converted from fenv.h
  10.                 See fenv.h for more information and comments.
  11. *)
  12.  
  13. (*$TAGS-*)
  14. (*$CALLING PASCAL*)
  15. MODULE fenv;
  16.  
  17. IMPORT SYSTEM;
  18.  
  19. (*$IF GENERATINGPOWERPC *)
  20. TYPE
  21. (*   fenv_t is a type for representing the entire floating-point
  22.       environment in a single object.                                         *)
  23.  
  24.     fenv_t* = LONGINT;
  25.  
  26. (*   fexcept_t is a type for representing the floating-point
  27.       exception flag state collectively.                                      *)
  28.  
  29.     fexcept_t* = LONGINT;
  30.  
  31. CONST
  32. (*    Definitions of floating-point exception macros                          *)
  33.  
  34.     FE_INEXACT*         = $02000000;       (*     inexact              *)
  35.     FE_DIVBYZERO*       = $04000000;       (*     divide-by-zero       *)
  36.     FE_UNDERFLOW*       = $08000000;       (*     underflow            *)
  37.     FE_OVERFLOW*        = $10000000;       (*     overflow             *)
  38.     FE_INVALID*         = $20000000;       (*     invlalid             *)
  39.  
  40. (*   Definitions of rounding direction macros                                *)
  41.  
  42.     FE_TONEAREST*       = $00000000;
  43.     FE_TOWARDZERO*      = $00000001;
  44.     FE_UPWARD*          = $00000002;
  45.     FE_DOWNWARD*        = $00000003;
  46.     
  47. (*$ELSE*)
  48.  
  49. CONST
  50.     FE_TONEAREST*       = $0000;
  51.     FE_UPWARD*          = $0001;
  52.     FE_DOWNWARD*        = $0002;
  53.     FE_TOWARDZERO*      = $0003;
  54.     
  55. (*   Definitions of rounding precision macros  (68K only)                    *)
  56.  
  57.     FE_LDBLPREC*        = $0000;
  58.     FE_DBLPREC*         = $0001;
  59.     FE_FLTPREC*         = $0002;
  60.  
  61.     (*$IF OPTION mc68881 *)
  62.     TYPE
  63.         fenv_t* =     RECORD
  64.                         FPCR*: LONGINT;
  65.                         FPSR*: LONGINT;
  66.                     END;
  67.         fexcept_t* = LONGINT;
  68.         
  69.     CONST
  70.         FE_INEXACT*         = $00000008;  
  71.         FE_DIVBYZERO*       = $00000010;     
  72.         FE_UNDERFLOW*       = $00000020;    
  73.         FE_OVERFLOW*        = $00000040;      
  74.         FE_INVALID*         = $00000080;   
  75.     
  76.     (*$ELSE*)
  77.     TYPE
  78.         fenv_t*    = INTEGER;
  79.         fexcept_t* = INTEGER;
  80.     CONST
  81.         FE_INVALID*         = $0001;   
  82.         FE_UNDERFLOW*       = $0002;    
  83.         FE_OVERFLOW*        = $0004;      
  84.         FE_DIVBYZERO*       = $0008;     
  85.         FE_INEXACT*         = $0010;  
  86.     (*$END*)
  87.     
  88. (*$END*)
  89.  
  90.  
  91. (*   The bitwise OR of all exception macros                                  *)
  92.  
  93.     FE_ALL_EXCEPT*  =   FE_INEXACT + FE_DIVBYZERO + FE_UNDERFLOW + FE_OVERFLOW + FE_INVALID;
  94.  
  95.  
  96. (*   Definition of pointer to IEEE default environment object                *)
  97. VAR
  98.     (*$PUSH*)
  99.     (*$J+*)
  100.     _FE_DFL_ENV*: fenv_t;   (*default environment object        *)
  101.     (*$POP*)
  102.  
  103.  
  104.  
  105. (******************************************************************************
  106. *     The following functions provide access to the exception flags.  The      *
  107. *     "int" input argument can be constructed by bitwise ORs of the exception  *
  108. *     macros*: for example*: FE_OVERFLOW | FE_INEXACT.                           *
  109. *******************************************************************************)
  110.  
  111. (*******************************************************************************
  112. *     The function "feclearexcept" clears the supported exceptions represented *
  113. *     by its argument.                                                         *
  114. *******************************************************************************)
  115.  
  116. PROCEDURE feclearexcept*(excepts: LONGINT); (*ΔΔC;ΔΔ*)
  117.     EXTERNAL (*•• C*);
  118.  
  119.  
  120.  
  121. (*******************************************************************************
  122. *    The function "fegetexcept" stores a representation of the exception       *
  123. *     flags indicated by the argument "excepts" through the pointer argument   *
  124. *     "flagp".                                                                 *
  125. *******************************************************************************)
  126.  
  127. PROCEDURE fegetexcept*( VAR flagp:    fexcept_t;
  128.                         excepts:    LONGINT ); (*ΔΔC;ΔΔ*)
  129.     EXTERNAL (*•• C*);
  130.  
  131.  
  132.  
  133. (*******************************************************************************
  134. *     The function "feraiseexcept" raises the supported exceptions             *
  135. *     represented by its argument.                                             *
  136. *******************************************************************************)
  137.  
  138. PROCEDURE feraiseexcept*( excepts:    LONGINT ); (*ΔΔC;ΔΔ*)
  139.     EXTERNAL (*•• C*);
  140.  
  141.  
  142.  
  143. (*******************************************************************************
  144. *     The function "fesetexcept" sets or clears the exception flags indicated  *
  145. *     by the int argument "excepts" according to the representation in the     *
  146. *     object pointed to by the pointer argument "flagp".  The value of         *
  147. *     "*flagp" must have been set by a previous call to "fegetexcept".         *
  148. *     This function does not raise exceptions; it just sets the state of       *
  149. *     the flags.                                                               *
  150. *******************************************************************************)
  151.  
  152. PROCEDURE fesetexcept*( VAR flagp:  fexcept_t; excepts:    LONGINT ); (*ΔΔC;ΔΔ*)
  153.     EXTERNAL (*•• C*);
  154.  
  155.  
  156.  
  157. (*******************************************************************************
  158. *     The function "fetestexcept" determines which of the specified subset of  *
  159. *     the exception flags are currently set.  The argument "excepts" specifies *
  160. *     the exception flags to be queried as a bitwise OR of the exception       *
  161. *     macros.  This function returns the bitwise OR of the exception macros    *
  162. *     corresponding to the currently set exceptions included in "excepts".     *
  163. *******************************************************************************)
  164.  
  165. PROCEDURE fetestexcept*( excepts: LONGINT ): LONGINT; (*ΔΔC;ΔΔ*)
  166.     EXTERNAL (*•• C*);
  167.  
  168.  
  169.  
  170. (*******************************************************************************
  171. *     The following functions provide control of rounding direction modes.     *
  172. *******************************************************************************)
  173.  
  174. (*******************************************************************************
  175. *     The function "fegetround" returns the value of the rounding direction    *
  176. *     macro which represents the current rounding direction.                   *
  177. *******************************************************************************)
  178.  
  179. PROCEDURE fegetround*(): LONGINT; (*ΔΔC;ΔΔ*)
  180.     EXTERNAL (*•• C*);
  181.  
  182.  
  183.  
  184. (*******************************************************************************
  185. *     The function "fesetround" establishes the rounding direction represented *
  186. *     by its argument.  It returns nonzero if and only if the argument matches *
  187. *     a rounding direction macro.  If not, the rounding direction is not       *
  188. *     changed.                                                                 *
  189. *******************************************************************************)
  190.  
  191. PROCEDURE fesetround*(round: LONGINT): LONGINT; (*ΔΔC;ΔΔ*)
  192.     EXTERNAL (*•• C*);
  193.  
  194.  
  195. (*******************************************************************************
  196. *    The following functions manage the floating-point environment, exception  *
  197. *    flags and dynamic modes, as one entity.                                   *
  198. *******************************************************************************)
  199.  
  200. (*******************************************************************************
  201. *     The function "fegetenv" stores the current floating-point environment    *
  202. *     in the object pointed to by its pointer argument "envp".                 *
  203. *******************************************************************************)
  204.  
  205. PROCEDURE fegetenv*( VAR envp:    fenv_t ); (*ΔΔC;ΔΔ*)
  206.     EXTERNAL (*•• C*);
  207.  
  208.  
  209.  
  210. (*******************************************************************************
  211. *     The function "feholdexcept" saves the current environment in the object  *
  212. *     pointed to by its pointer argument "envp", clears the exception flags,   *
  213. *     and clears floating-point exception enables.  This function supersedes   *
  214. *     the SANE function "procentry", but it does not change the current        *
  215. *     rounding direction mode.                                                 *
  216. *******************************************************************************)
  217.  
  218. PROCEDURE feholdexcept*( VAR envp: fenv_t ): LONGINT; (*ΔΔC;ΔΔ*)
  219.     EXTERNAL (*•• C*);
  220.  
  221.  
  222.  
  223. (*******************************************************************************
  224. *     The function "fesetenv" installs the floating-point environment          *
  225. *     environment represented by the object pointed to by its argument         *
  226. *     "envp".  The value of "*envp" must be set by a call to "fegetenv" or     *
  227. *     "feholdexcept", by an implementation-defined macro of type "fenv_t",     *
  228. *     or by the use of the pointer macro FE_DFL_ENV as the argument.           *
  229. *******************************************************************************)
  230.  
  231. PROCEDURE fesetenv*( VAR envp: fenv_t ); (*ΔΔC;ΔΔ*)
  232.     EXTERNAL (*•• C*);
  233.  
  234.  
  235.  
  236. (*******************************************************************************
  237. *     The function "feupdateenv" saves the current exceptions into its         *
  238. *     automatic storage, installs the environment represented through its      *
  239. *     pointer argument "envp", and then re-raises the saved exceptions.        *
  240. *     This function, which supersedes the SANE function "procexit", can be     *
  241. *     used in conjunction with "feholdexcept" to write routines which hide     *
  242. *     spurious exceptions from their callers.                                  *
  243. *******************************************************************************)
  244.       
  245. PROCEDURE feupdateenv*( VAR envp: fenv_t ); (*ΔΔC;ΔΔ*)
  246.     EXTERNAL (*•• C*);
  247.  
  248. (*$IF GENERATING68K*)
  249.  
  250. (*******************************************************************************
  251. *     The following functions provide control of rounding precision.           *
  252. *     Because the PowerPC does not provide this capability, these functions    *  
  253. *     are available only for the 68K Macintosh.  Rounding precision values     *
  254. *     are defined by the rounding precision macros.  These functions are       *
  255. *     equivalent to the SANE functions getprecision and setprecision.          *
  256. *******************************************************************************)
  257.  
  258. PROCEDURE fegetprec*(): LONGINT; (*ΔΔC;ΔΔ*)
  259.     EXTERNAL (*•• C*);
  260. PROCEDURE fesetprec* (precision: LONGINT): LONGINT; (*ΔΔC;ΔΔ*)
  261.     EXTERNAL (*•• C*);
  262.  
  263. (*$END*)
  264.  
  265.  
  266.  END fenv.
  267.